﻿namespace SimpleFMMatrix.DataStructures

open System
open System.Numerics
open MathNet.Numerics.IntegralTransforms
open MathNet.Numerics.IntegralTransforms.Algorithms
open NAudio.Wave

module InternalTypes =
    [<Literal>]
    let SampleRate = 44100
    [<Literal>]
    let FloatSampleRate = 44100.0
    [<Literal>]
    let SamplePeriod = 2.2675736961451247165532879818594e-5

    [<AbstractClass>]
    type internal DoubleWaveSeq () =
        let format = WaveFormat.CreateIeeeFloatWaveFormat (SampleRate, 2)
        member this.SampleRate = SampleRate
        abstract member Read : buffer : float32[] * offset : int * count : int -> unit
        interface IWaveProvider with
            member this.WaveFormat = format
            member this.Read (buffer, offset, count) =
                let buf = new WaveBuffer (buffer)
                let samplesRead = this.Read (buf.FloatBuffer, offset / 4, count / 4)
                count

type LookUpTable (mint, maxt, intervalcount) =
    let mutable table = Array.create (intervalcount + 1) 0.0
    member val MinT = mint with get, set
    member val MaxT = maxt with get, set
    member this.Update x =
        table <- Array.init (intervalcount + 1) x
    member this.LookUp t =
        match t with
        | t when t >= this.MaxT -> table.[intervalcount]
        | t when t <= this.MinT -> table.[0]
        | t ->
            let i = (t - this.MinT) / ((this.MaxT - this.MinT) / float intervalcount)
            let ifloor = Math.Floor i
            let iceil = Math.Ceiling i
            (iceil - i) * table.[int ifloor] + (i - ifloor) * table.[int iceil]
    member this.Table = table :> seq<float>

type EnvelopePhase (slope, duration, endOffset) =
    new () = EnvelopePhase (0.0, 1.0, 1.0)
    member val Slope = slope with get, set
    member val Duration = duration with get, set
    member val EndLevel = endOffset with get, set
    member this.AmplitudeAt (startlevel, t) =
        let _exp = 2.0 ** (Math.Abs this.Slope)
        let _t =
            match this.Duration with
            | d when d <= 0.0 -> 0.0
            | d -> t / d
        let _a =
            match this.Slope with
            | s when s >= 0.0 -> _t ** _exp
            | s -> 1.0 - (1.0 - _t) ** _exp
        _a * (this.EndLevel - startlevel) + startlevel

type Envelope () =
    let attack = EnvelopePhase (-2.0, 0.05, 1.0)
    let decay = EnvelopePhase (-2.0, 0.25, 0.8)
    let release = EnvelopePhase (-2.0, 0.5, 0.0)
    member val KeyOnLevel = 0.0 with get, set
    member this.Attack = attack
    member this.Decay = decay
    member this.Release = release
    member this.IsReleased t =
        t > release.Duration

type Operator (index) =
    let envelope = Envelope ()
    member val Ratio = 1.0 with get, set
    member val Offset = 0.0 with get, set
    member this.Envelope = envelope
    member this.Index = index

[<AbstractClass>]
type FMMatrixBase () =
    abstract member Operators : Operator[]
    abstract member ModIndices : int[,]
    abstract member OutputLevels : int[]

type FMNote (f0 : float, matrix : FMMatrixBase, velocity : float) =
    let lastX = Array.create 6 0.0
    let mutable keyUpLevels = Array.create 6 1.0
    let mutable t = 0.0
    let mutable at = 0.0
    let mutable releasePhase = false
    let mutable noteEnded = false
    abstract GetEnvelopeValue : int -> float
    default this.GetEnvelopeValue i =
        let e = matrix.Operators.[i].Envelope
        match releasePhase with
        | false ->
            match at with
            | at when at >= e.Attack.Duration + e.Decay.Duration ->
                e.Decay.EndLevel
            | at when at >= e.Attack.Duration ->
                e.Decay.AmplitudeAt (e.Attack.EndLevel, at - e.Attack.Duration)
            | at when at >= 0.0 ->
                e.Attack.AmplitudeAt (e.KeyOnLevel, at)
            | at ->
                0.0
        | true ->
            match at with
            | at when at < 0.0 ->
                0.0
            | at when at <= e.Release.Duration ->
                e.Release.AmplitudeAt (keyUpLevels.[i], at)
            | at ->
                0.0
    member this.Release () =
        if not releasePhase then
            for i in 0 .. 5 do
                keyUpLevels.[i] <- this.GetEnvelopeValue i
            releasePhase <- true
            at <- 0.0
    member this.NoteEnded = noteEnded
    member this.Next () =
        let mutable _noteEnded = true
        let mutable result = 0.0
        for i = 0 to 5 do
            let mutable _phase = 0.0
            for j = 0 to 5 do
                let _mtxi = float matrix.ModIndices.[i, j]
                let _i = _mtxi * _mtxi / 100000.0
                _phase <- _phase + _i * lastX.[j]
            let _a = this.GetEnvelopeValue i
            let _fin = releasePhase && matrix.Operators.[i].Envelope.IsReleased at
            let _freq = Math.Max (matrix.Operators.[i].Ratio * f0 + matrix.Operators.[i].Offset, 0.0)
            let _norx = Math.Sin (2.0 * Math.PI * _freq * t + _phase)
            let _x = _a * _norx
            let _sqrtlv = float matrix.OutputLevels.[i] / 1000.0
            let _lv = _sqrtlv * _sqrtlv
            lastX.[i] <- _x
            _noteEnded <- _noteEnded && _fin
            result <- result + _x * _lv * velocity
        t <- t + InternalTypes.SamplePeriod
        at <- at + InternalTypes.SamplePeriod
        noteEnded <- _noteEnded
        result
    member this.Read (buffer : float32[], locks : obj [], offset, count) =
        for h in offset .. 2 .. offset + count - 1 do
            let result32 = float32 (this.Next ())
            lock locks.[h]
                (fun () ->
                    buffer.[h + 0] <- buffer.[h + 0] + result32
                    buffer.[h + 1] <- buffer.[h + 1] + result32)

type FMWaveFormVisualizer (f0, matrix) =
    inherit FMNote (f0, matrix, 1.0)
    override this.GetEnvelopeValue i = 1.0
    member this.GetSamples count =
        Seq.init count (fun i -> this.Next ())
        |> System.Linq.Enumerable.ToList

type internal FMWaveSeq (matrix : FMMatrixBase) =
    inherit InternalTypes.DoubleWaveSeq ()
    let notes = System.Collections.Generic.List<FMNote> ()
    let mutable locks : obj[] = Array.init 0 (fun i -> obj ())
    member this.AllNotes = lock (notes) (fun () -> notes.ToArray ()) :> seq<FMNote>
    member this.Play f0 =
        let n = FMNote (f0, matrix, 0.1)
        lock (notes) (fun () -> notes.Add n)
        n
    override this.Read (buffer, offset, count) =
        if locks.Length <> buffer.Length then
            locks <- Array.init buffer.Length (fun i -> obj ())
        for i in offset .. offset + count - 1 do
            buffer.[i] <- 0.0f
        let notes2 = lock (notes) (fun () -> notes.ToArray ())
        notes2
        :> seq<FMNote>
        |> Seq.map (fun n -> async { n.Read (buffer, locks, offset, count) })
        |> Async.Parallel
        |> Async.RunSynchronously 
        |> ignore
        lock (notes) (fun () -> notes.RemoveAll (fun n -> n.NoteEnded))
        |> ignore

type FMMatrix () as this =
    inherit FMMatrixBase ()
    let operators = Array.init 6 (fun i -> Operator (i))
    let modIndices = Array2D.create 6 6 0
    let outputLevels = Array.create 6 0
    let waveseq = FMWaveSeq this
    override this.Operators = operators
    override this.ModIndices = modIndices
    override this.OutputLevels = outputLevels
    member this.WaveProvider = waveseq :> IWaveProvider
    member this.Play f0 = waveseq.Play f0
    member this.AllPlayingNotes = waveseq.AllNotes
    member this.PreviewWaveForm () =
        let v = FMWaveFormVisualizer (344.53125, this)
        v.GetSamples 256
    member this.PreviewSpectrum () =
        let v = FMWaveFormVisualizer (16.0 / 512.0 * InternalTypes.FloatSampleRate, this)
        let transform = DiscreteFourierTransform ()
        let _ = v.GetSamples 512
        let f = v.GetSamples 512
        let a =
            f
            |> Seq.map (fun x -> Complex (x, 0.0))
            |> Array.ofSeq
        transform.Radix2Forward (a, FourierOptions.Default)
        a
        |> Seq.ofArray
        |> Seq.skip 1
        |> Seq.take 256
        |> Seq.map (fun c -> Math.Sqrt (c.Magnitude / 16.0))
        |> System.Linq.Enumerable.ToArray



